home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL 2.0b1 Patches / MCL 2.0b1 Source Patches / font-menus-patch.lisp next >
Encoding:
Text File  |  1991-04-02  |  1.3 KB  |  26 lines  |  [TEXT/CCL2]
  1. ;; font-menus-patch.lisp
  2. ;; This is a source patch for the file "examples;font-menus.lisp"
  3. ;; It prevents an error when clicking in the menubar when there are no
  4. ;; windows opened.
  5.  
  6. (in-package :ccl)                       ; in case someone EVALs this buffer
  7.  
  8. (defmethod menu-item-update ((item font-menu-item))
  9.   (multiple-value-bind (current-font first-character-font) 
  10.                        ;; some views only return the current font
  11.                        (let ((w (front-window)))
  12.                          (and w (view-font w)))
  13.     (let ((selection-font (or first-character-font current-font))
  14.           (my-attribute (slot-value item 'my-attribute)))
  15.       (set-menu-item-check-mark item
  16.                                 (not (not (member my-attribute
  17.                                                   selection-font
  18.                                                   :test #'equalp))))
  19.       (when (and selection-font
  20.                  (integerp my-attribute))   ; if it's a size attribute
  21.         (set-menu-item-style item 
  22.                              (if (real-font (substitute-if my-attribute
  23.                                                            #'integerp
  24.                                                            selection-font))
  25.                                :outline
  26.                                :plain))))))